home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Games / Puzzles / WordFind / wordsearch.new < prev   
Encoding:
Text File  |  1987-11-14  |  11.7 KB  |  431 lines  |  [TEXT/PJMM]
  1. (**)
  2. (*This is an attempt to write a generic word search program*)
  3. (*The idea will be that the user will type in a list of words and the computer will *)
  4. (*put the words into a large matrix and then print out that matrix with the words *)
  5. (*underneath it*)
  6. (*This new version contains a multicolumn option that prints with tabs*)
  7. (*11/9 added repeat through loop so that you can make multiple puzzles*)
  8. (*11/9 mixed in code from spanish version to make one unified *)
  9. (*multilingual version*)
  10. PROGRAM wordsearch;
  11.     USES
  12.         placepuzzle, stringf, sorts;
  13.     CONST
  14.         VERSION = '1.3ß';
  15.     TYPE
  16.         location = RECORD
  17.                 x : integer;
  18.                 y : integer;
  19.             END;
  20.     VAR
  21.         wordcount, i, j, k, numcol : integer;
  22.         fname : STRING;
  23.         ff : text;
  24.         answer : STRING;
  25.         screen : Rect;
  26.         reptest : boolean;
  27.         ok : boolean;
  28.     PROCEDURE initmat;
  29.         VAR
  30.             i, j : integer;
  31.     BEGIN
  32.         FOR i := 1 TO XMAX DO
  33.             FOR j := 1 TO YMAX DO
  34.                 BEGIN
  35.                     puzzle[i, j].ch := ' ';
  36.                     puzzle[i, j].boldf := false;
  37.                 END;
  38.         FOR i := 1 TO MAXWORDS DO
  39.             ourlist[i] := ' ';
  40.     END;
  41.     PROCEDURE copyright;
  42.     BEGIN
  43.         writeln('WordFind version ', VERSION);
  44.         writeln('(c) 1987 Matthew Weinstein');
  45.         writeln('Portions copyright by THINK Technologies, Inc.');
  46.         writeln;
  47.         writeln;
  48.         writeln('Working on this project confirmed everything I always thought about PASCAL');
  49.         writeln('It is back to C forever for me!');
  50.         writeln('Next step is to give this a mac interface.');
  51.         writeln('Feel free to give both source code and program to whomever…');
  52.         writeln('Just include this copyright');
  53.         writeln('Also if you feel like donating any money to the cause (NO obligation)');
  54.         writeln('      send it to : ');
  55.         writeln('Matthew Weinstein; 2128 Hayes St.;San Francisco, CA  94117');
  56.         writeln;
  57.     END;
  58.     FUNCTION readlist : boolean;
  59.         VAR
  60.             c : char;
  61.             k : integer;
  62.     BEGIN
  63.         wordcount := 1;
  64.         WHILE (ourlist[wordcount] <> '2') AND (ourlist[wordcount] <> '3') AND (wordcount < MAXWORDS) DO
  65.             BEGIN
  66.                 readln(ourlist[wordcount]);
  67.                 upper(ourlist[wordcount]);
  68.                 sstrip(ourlist[wordcount]);
  69.  
  70.                 IF length(ourlist[wordcount]) > 0 THEN {catch all carriage returns}
  71.                     IF ourlist[wordcount] = '1' THEN
  72.                         BEGIN
  73.                             wordcount := 1;
  74.                             writeln;
  75.                             writeln('Start again.');
  76.                             writeln;
  77.                         END
  78.                     ELSE IF ourlist[wordcount] = '2' THEN
  79.                         readlist := false
  80.                     ELSE IF ourlist[wordcount] = '3' THEN
  81.                         readlist := true
  82.                     ELSE
  83.                         BEGIN
  84.                             makealpha(ourlist[wordcount]);
  85.                             IF length(ourlist[wordcount]) > 0 THEN {is there anything left after stripping non alphas}
  86.                                 wordcount := wordcount + 1;
  87.                         END;
  88.             END;
  89.         IF wordcount = MAXWORDS THEN
  90.             readlist := true;
  91.         wordcount := wordcount - 1;
  92.     END;
  93. { fill in random letters wherever there is a space }
  94. { fill in random letters wherever there is a space }
  95.     PROCEDURE fillpuzzle;
  96.         VAR
  97.             i, j : integer;
  98.     BEGIN
  99.         FOR i := 1 TO XMAX DO
  100.             FOR j := 1 TO YMAX DO
  101.                 IF puzzle[i, j].ch = ' ' THEN
  102.                     puzzle[i, j].ch := upalpha[randnum(alphsize)];
  103.     END;
  104.     PROCEDURE writelist (numc : integer);
  105.         CONST
  106.             COLWIDTH = 20;
  107.         VAR
  108.             k, j, i : integer;
  109.             thisword, nextword : integer;
  110.             colsize : integer;
  111.             colextra : integer;
  112.     BEGIN
  113.         colsize := wordcount DIV numc;
  114.         colextra := wordcount MOD numc;
  115.         IF colextra <> 0 THEN
  116.             colsize := colsize + 1;
  117.         FOR j := 1 TO colsize DO
  118.             FOR i := 1 TO numc DO
  119.                 BEGIN
  120.                     IF (i <= colextra) OR (colextra = 0) THEN
  121.                         BEGIN
  122.                             thisword := j + (i - 1) * colsize;
  123.                             nextword := j + i * colsize;
  124.                         END
  125.                     ELSE
  126.                         BEGIN
  127.                             thisword := j + colextra * colsize + (i - 1 - colextra) * (colsize - 1);
  128.                             nextword := j + colextra * colsize + (i - colextra) * (colsize - 1);
  129.                         END;
  130.             (* only print the word if we are in the colextra region or if we are less than colsize*)
  131.                     IF (thisword <= wordcount) AND ((i <= colextra) OR (j < colsize) OR (colextra = 0)) THEN
  132.                         write(ourlist[thisword]);
  133.                     IF (i = numc) THEN
  134.                         writeln
  135.                     ELSE IF (thisword < wordcount) AND NOT (nextword > wordcount) THEN
  136.                         IF length(ourlist[thisword]) <= COLWIDTH THEN
  137.                             FOR k := 1 TO COLWIDTH - length(ourlist[thisword]) DO
  138.                                 write(' ');
  139.                 END;
  140.     END;
  141.     PROCEDURE printoutlist (numc : integer);
  142.         CONST
  143.             COLWIDTH = 20;
  144.         VAR
  145.             k, j, i : integer;
  146.             thisword, nextword : integer;
  147.             colsize : integer;
  148.             colextra : integer;
  149.     BEGIN
  150.         colsize := wordcount DIV numc;
  151.         colextra := wordcount MOD numc;
  152.         IF colextra <> 0 THEN
  153.             colsize := colsize + 1;
  154.         FOR j := 1 TO colsize DO
  155.             FOR i := 1 TO numc DO
  156.                 BEGIN
  157.                     IF (i <= colextra) OR (colextra = 0) THEN
  158.                         BEGIN
  159.                             thisword := j + (i - 1) * colsize;
  160.                             nextword := j + i * colsize;
  161.                         END
  162.                     ELSE
  163.                         BEGIN
  164.                             thisword := j + colextra * colsize + (i - 1 - colextra) * (colsize - 1);
  165.                             nextword := j + colextra * colsize + (i - colextra) * (colsize - 1);
  166.                         END;
  167.             (* only print the word if we are in the colextra region or if we are less than colsize*)
  168.                     IF (thisword <= wordcount) AND ((i <= colextra) OR (j < colsize) OR (colextra = 0)) THEN
  169.                         write(ff, ourlist[thisword]);
  170.                     IF (i = numc) THEN
  171.                         writeln(ff)
  172.                     ELSE IF (thisword < wordcount) AND NOT (nextword > wordcount) THEN
  173.                         IF length(ourlist[thisword]) <= COLWIDTH THEN
  174.                             FOR k := 1 TO COLWIDTH - length(ourlist[thisword]) DO
  175.                                 write(ff, ' ');
  176.                 END;
  177.     END;
  178.  
  179.     PROCEDURE printlist (numc : integer);
  180.         VAR
  181.             j, i : integer;
  182.             colsize : integer;
  183.             colextra : integer;
  184.             thisword, nextword : integer;
  185.     BEGIN
  186.         writeln(ff); (* place a blank line between the puzzle and the list *)
  187.         colsize := wordcount DIV numc;
  188.         colextra := wordcount MOD numc;
  189.         IF colextra <> 0 THEN
  190.             colsize := colsize + 1;
  191.         FOR j := 1 TO colsize DO
  192.             FOR i := 1 TO numc DO
  193.                 BEGIN
  194.                     IF (i <= colextra) OR (colextra = 0) THEN
  195.                         BEGIN
  196.                             thisword := j + (i - 1) * colsize;
  197.                             nextword := j + i * colsize;
  198.                         END
  199.                     ELSE
  200.                         BEGIN
  201.                             thisword := j + colextra * colsize + (i - 1 - colextra) * (colsize - 1);
  202.                             nextword := j + colextra * colsize + (i - colextra) * (colsize - 1);
  203.                         END;
  204.                     IF (thisword <= wordcount) AND ((i <= colextra) OR (j < colsize) OR (colextra = 0)) THEN
  205.                         write(ff, ourlist[thisword]);
  206.                     IF i = numc THEN
  207.                         writeln(ff)
  208. (* print a tab if this word is less than word count and the next word # is greater than word count*)
  209.                     ELSE IF (thisword < wordcount) AND NOT (nextword > wordcount) THEN
  210.                         write(ff, chr(9)) (* tab *)
  211.                 END;
  212.     END;
  213.  
  214.     PROCEDURE printpuzzle;
  215.         VAR
  216.             i, j : integer;
  217.     BEGIN
  218.         FOR i := 1 TO YMAX DO
  219.             BEGIN
  220.                 FOR j := 1 TO XMAX DO
  221.                     BEGIN
  222.                         write(ff, puzzle[j, i].ch, ' ');
  223.                     END;
  224.                 writeln(ff);
  225.             END;
  226.     END;
  227.     PROCEDURE writepuzzle;
  228.         VAR
  229.             i, j : integer;
  230.     BEGIN
  231.         FOR i := 1 TO YMAX DO
  232.             BEGIN
  233.                 FOR j := 1 TO XMAX DO
  234.                     BEGIN
  235.                         write(puzzle[j, i].ch, ' ');
  236.                     END;
  237.                 writeln;
  238.             END;
  239.     END;
  240.     PROCEDURE writeanswer;
  241.         VAR
  242.             i, j : integer;
  243.     BEGIN
  244.         FOR i := 1 TO YMAX DO
  245.             BEGIN
  246.                 FOR j := 1 TO XMAX DO
  247.                     BEGIN
  248.                         IF puzzle[j, i].boldf = true THEN
  249.                             write(puzzle[j, i].ch, ' ')
  250.                         ELSE
  251.                             write(' ', ' ');
  252.                     END;
  253.                 writeln;
  254.             END;
  255.     END;
  256.     PROCEDURE printanswer;
  257.         VAR
  258.             i, j : integer;
  259.     BEGIN
  260.         FOR i := 1 TO YMAX DO
  261.             BEGIN
  262.                 FOR j := 1 TO XMAX DO
  263.                     BEGIN
  264.                         IF puzzle[j, i].boldf = true THEN
  265.                             write(ff, puzzle[j, i].ch, ' ')
  266.                         ELSE
  267.                             write(ff, ' ', ' ');
  268.                     END;
  269.                 writeln(ff);
  270.             END;
  271.     END;
  272.  
  273. BEGIN
  274. (* for each language implementation these 2 lines have to*)
  275. (*be changed*)
  276.     upalpha := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  277.     lowalpha := 'abcdefghijklmnopqrstuvwxyz';
  278.  
  279.     screen.top := 40;
  280.     screen.bottom := 335;
  281.     screen.left := 5;
  282.     screen.right := 500;
  283.     setTextRect(screen);
  284.     ShowText;
  285.     copyright;
  286.     REPEAT
  287.         BEGIN
  288.             writeln;
  289.             writeln;
  290.             REPEAT
  291.                 write('Enter random number from 1 to 5000; 0 to quit: ');
  292.                 readln(randSeed);
  293.             UNTIL randseed >= 0;
  294.             IF randseed <> 0 THEN
  295.                 BEGIN
  296.                     writeln;
  297.                     REPEAT
  298.                         write('How many across should the puzzle be? (less or equal to ', MAXX : 3, ') ');
  299.                         readln(XMAX);
  300.                     UNTIL (XMAX <= MAXX) AND (XMAX > 1);
  301.                     REPEAT
  302.                         write('How many down should the puzzle be? (less or equal to ', MAXY : 3, ') ');
  303.                         readln(YMAX);
  304.                     UNTIL (YMAX <= MAXY) AND (YMAX > 1);
  305.                     writeln('Setting up the puzzle…');
  306.                     initmat;
  307.                     writeln;
  308.                     writeln('Type "1" to START OVER.');
  309.                     writeln('Type "2" to QUIT.');
  310.                     writeln('Type "3" when done.');
  311.                     writeln('Enter the words to be wordsearched: (Hit return after each.)');
  312.                     writeln;
  313.                     IF readlist = true THEN{get the list of words}
  314.                         BEGIN
  315.                             write('Working');
  316.                             ssort1(wordcount); {put in size order}
  317.                             i := 0;
  318.                             WHILE i <> wordcount DO
  319.                                 BEGIN
  320.                                     i := i + 1;
  321.                                     write('.'); (*let the folks know were there*)
  322.                                     IF rightlen(ourlist[i]) = true THEN
  323.                                         BEGIN
  324.                                             j := 0;
  325.                                             REPEAT
  326.                                                 ok := placerandom(ourlist[i]);
  327.                                                 j := j + 1;
  328.                                             UNTIL (j = 20) OR (ok = true);
  329.                                             IF ok = false THEN
  330.                                                 IF placeanyplace(ourlist[i]) = false THEN
  331.                                                     BEGIN
  332.                                                         writeln('Can not place ', ourlist[i]);
  333.                                                         IF i <> wordcount THEN
  334.                                                             FOR j := i TO wordcount - 1 DO
  335.                                                                 ourlist[j] := ourlist[j + 1];
  336.                                                         wordcount := wordcount - 1;
  337.                                                         i := i - 1;
  338.                                                     END; (*placeanyplace*)
  339.                                         END(* rightlen *)
  340.                                     ELSE (*rightlen*)
  341.                                         BEGIN
  342.                                             writeln;
  343.                                             writeln(ourlist[i], ' is too large to fit in a ', XMAX : 3, ' by ', YMAX : 3, ' puzzle.');
  344.                                             IF i <> wordcount THEN
  345.                                                 FOR j := i TO wordcount - 1 DO
  346.                                                     ourlist[j] := ourlist[j + 1];
  347.                                             wordcount := wordcount - 1;
  348.                                             i := i - 1; (* done so incrementer looks at new ith word*)
  349.                                         END;
  350.                                 END; (* for i *)
  351.                             IF wordcount > 0 THEN
  352.                                 BEGIN
  353.                                     writeln;
  354.                                     fillpuzzle;
  355.                                     writeln;
  356.                                     REPEAT
  357.                                         write('How many columns across should I print the clues? ');
  358.                                         readln(numcol);
  359.                                     UNTIL numcol < wordcount;
  360.                                     writeln;
  361.                                     writepuzzle;
  362.                                     writeln;
  363.                                     ssort2(wordcount);
  364.                                     writelist(numcol);
  365.                                     writeln;
  366.                                     writeln('Type "NONE" for no save.');
  367.                                     Writeln('Type "PRINTER:" to print out puzzle.');
  368.                                     writeln('Type "QUIT" to quit.');
  369.                                     write('Enter file to save your puzzle: ');
  370.                                     readln(fname);
  371.                                     upper(fname);
  372.                                     sstrip(fname);
  373.                                     IF fname <> 'QUIT' THEN
  374.                                         BEGIN
  375.                                             IF fname <> 'NONE' THEN
  376.                                                 BEGIN
  377.                                                     rewrite(ff, fname);
  378.                                                     printpuzzle;
  379.                                                     IF fname <> 'PRINTER:' THEN
  380.                                                         printlist(numcol)
  381.                                                     ELSE
  382.                                                         printoutlist(numcol);
  383.                                                     close(ff);
  384.                                                 END;
  385.                                             writeln;
  386.                                             write('Print solution (Y or N)? ');
  387.                                             readln(answer);
  388.                                             upper(answer);
  389.                                             sstrip(answer);
  390.                                             IF answer[1] = 'Y' THEN
  391.                                                 BEGIN
  392.                                                     writeanswer;
  393.                                                     writeln;
  394.                                                     Writeln('Type "PRINTER:" to print out solution.');
  395.                                                     writeln('Type "QUIT" to quit.');
  396.                                                     write('Enter file to save your solution: ');
  397.                                                     readln(fname);
  398.                                                     upper(fname);
  399.                                                     sstrip(fname);
  400.                                                     IF fname <> 'QUIT' THEN
  401.                                                         BEGIN
  402.                                                             rewrite(ff, fname);
  403.                                                             printanswer;
  404.                                                             close(ff);
  405.                                                         END;
  406.  
  407.                                                 END;
  408.  
  409.                                         END;
  410.                                 END (*wordlist*)
  411.                             ELSE
  412.                                 BEGIN
  413.                                     writeln;
  414.                                     writeln('No words fit into the puzzle; try again.');
  415.                                     write('Hit return to continue');
  416.                                     readln(answer);
  417.                                 END;
  418.                         END; {readlist}
  419.                 END; (* randseed*)
  420.         END;
  421.         writeln;
  422.         write('Make another puzzle (Y or N)? ');
  423.         readln(answer);
  424.         upper(answer);
  425.         sstrip(answer);
  426.         IF answer[1] = 'Y' THEN
  427.             reptest := true
  428.         ELSE
  429.             reptest := false;
  430.     UNTIL reptest = false;
  431. END.